home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-11
/
rlib.zip
/
RL_PDOWN.PRG
< prev
next >
Wrap
Text File
|
1993-01-04
|
15KB
|
460 lines
* Function..: PDOWNINIT
* Author....: Richard Low
* Syntax....: PDOWNINIT( row, columns, options, items, starts, prompts,;
* promptrow, colors, altkeys, exit )
*
* Notes.....: Mandatory function to initialize PDOWNMENU for operation.
* Optional parameters are not required, but if you wish to skip
* an optional parameter, you must pass a dummy value. The best
* dummy value to use is a null string '' (set up a memvar named
* dummy where dummy = '').
*
* Parameters: row - NUMERIC row for top of Pull Down Menu to appear.
* columns - ARRAY of column numbers for each top level option.
* options - ARRAY of top level menu option choices.
* items - ARRAY of pulled down menu items.
* starts - ARRAY of starting element numbers.
* prompts - Optional ARRAY corresponding menu item messages.
* promptrow - Optional NUMERIC row on which these messages appear.
* colors - Optional ARRAY of colors to use for the top Bar and
* pull down Box menus.
*
* color[1] - Option & message displays
* color[2] - Menu selection bars
* color[3] - Pull-down menu box ACTIVE color
* color[4] - Pull-down menu box IN-ACTIVE color
* color[5] - Pull-down menu option after selection
* color[6] - Menu bar option after selection
*
* altkeys - Optional ARRAY of alternate select keys for each menu.
* exit - Optional LOGICAL indicating if escape will exit menu.
*
* Returns...: True if initialization sucessful, False if parameters error.
*
FUNCTION PDOWNINIT
PARAMETERS prow, pcols, pmenus, pitems, pstarts, pprompts, promptrow,;
p_colors, paltkeys, pexit
IF PCOUNT() = 0
*-- if no parameters, release PUBLIC arrays to reclaim memory
RELEASE rl_pd, pd_counts, pd_altkeys, pd_bottoms, pd_rights
RETURN (.T.)
ENDIF
*-- make sure that all the required parameters are the correct type
IF TYPE('prow') + TYPE('pcols') + TYPE('pmenus') +;
TYPE('pitems') + TYPE('pstarts') != 'NAAAA'
RETURN (.F.)
ENDIF
*-- the number of columns, top level options, starting array element
*-- numbers, and menu item counts must all be the same
IF .NOT. ( LEN(pcols) = LEN(pmenus) .AND. LEN(pcols) = LEN(pstarts) )
RETURN (.F.)
ENDIF
*-- there must be more than one menu (get real)
IF LEN(pcols) < 2
RETURN (.F.)
ENDIF
last_menu = LEN(pmenus)
PUBLIC pd_counts[last_menu], pd_altkeys[last_menu]
PUBLIC pd_bottoms[last_menu], pd_rights[last_menu]
*-- fill in menu item counts based on start numbers
*-- can't start at 1 because of computational algorithm
pd_counts[1] = pstarts[2] - 1
FOR x = 2 TO last_menu - 1
*-- count of options in this menu equal next start number minus this start
pd_counts[x] = pstarts[x+1] - pstarts[x]
NEXT x
*-- number of items in last menu is equal to length of array - starting # + 1
pd_counts[ last_menu ] = LEN(pitems) - pstarts[ last_menu ] + 1
*-- copy the altkeys array if it exists
IF TYPE('paltkeys') = 'A'
ACOPY( paltkeys, pd_altkeys )
ELSE
*-- otherwise fill it with nulls
AFILL( pd_altkeys, '' )
ENDIF
AFILL( pd_bottoms, 0 )
AFILL( pd_rights, 0 )
*-- make configuration array public
PUBLIC rl_pd[15]
rl_pd[ 1] = LEN(pmenus) && N - number of menus (used for offset)
rl_pd[ 2] = '' && C - main menu direct select keys
rl_pd[ 3] = IF(TYPE('pbox')='C', pbox, '┌─┐│┘─└│') && C - boxing string
rl_pd[ 4] = SETCOLOR() && save incoming color
*-- use <color array> if it is an array AND it has at least 5 elements
IF IF( TYPE('p_colors') = 'A', IF(LEN(p_colors) >= 5, .T., .F.) , .F. )
rl_pd[ 6] = p_colors[1] && display color
rl_pd[ 7] = p_colors[2] && menu bar color
rl_pd[ 8] = p_colors[3] && active pull down menu box color
rl_pd[ 9] = p_colors[4] && pull down menu box border after exit
rl_pd[10] = p_colors[5] && pull down menu selected option color
rl_pd[ 5] = p_colors[6] && top bar menu selected option color
ELSE
rl_pd[ 6] = rl_pd[4]
rl_pd[ 7] = GETPARM(2, rl_pd[4])
rl_pd[ 8] = BRIGHT(rl_pd[4])
rl_pd[ 9] = rl_pd[4]
rl_pd[10] = rl_pd[8]
rl_pd[ 5] = rl_pd[8]
ENDIF
*-- window coordinates and buffer
rl_pd[11] = prow && N - <maxtop> (top row for main menu)
rl_pd[12] = pcols[1] && N - <maxleft>
rl_pd[13] = 0 && N - <maxbottom>
rl_pd[14] = 0 && N - <maxright>
rl_pd[15] = '' && C - window to hold screen
*-- display bar menu options and build a list of first letter pick keys
*-- and store coordinates for later fast access, and determine maximum
*-- bottom and right coordinates
xjunk = ''
SETCOLOR(rl_pd[6])
@ prow,0 && clear option line in that color
FOR x = 1 TO LEN(pmenus)
@ prow,pcols[x] SAY pmenus[x]
xjunk = xjunk + SUBSTR( LTRIM(pmenus[x]),1,1 ) && build list of direct pick keys
pd_bottoms[x] = prow + pd_counts[x] + 2 && bottom coordinate for this menu
pd_rights[x] = pcols[x] + LEN(pitems[pstarts[x]]) + 1 && right coordinate for this menu
rl_pd[13] = MAX( rl_pd[13], pd_bottoms[x] )
rl_pd[14] = MAX( rl_pd[14], pd_rights[x] )
*-- fill direct select strings with default first letters for each menu
yjunk = ''
FOR y = 1 TO pd_counts[x]
yjunk = yjunk + SUBSTR(LTRIM(pitems[pstarts[x]+y-1]),1,1)
NEXT y
*-- now add to list passed as parameter, if any
pd_altkeys[x] = yjunk + pd_altkeys[x]
NEXT x
*-- set color back to way it was
SETCOLOR(rl_pd[4])
*-- main menu direct and alternate select keys
rl_pd[2] = xjunk
*-- save screen that was painted with top menu options
rl_pd[15] = SAVESCREEN(rl_pd[11],rl_pd[12],rl_pd[13],rl_pd[14])
RETURN (.T.)
*****************************************************************************
* Function..: PDOWNMENU
* Syntax....: PDOWNMENU( @menu, @item, menus, items, columns, starts;
* [, prompts [, exit ] ] )
*
* Notes.....: Pull down menu operation AFTER initialized with PDOWNINIT(...)
* All but the last two parameters are required! If the <prompts>
* are not used, but <exit> is, pass a dummy parameter for <prompts>
*
* Parameters: @menu - pointer to NUMERIC indicating starting top menu option
* @item - pointer to NUMERIC starting menu item (if any) 0 = stay in top
* menus - ARRAY of top level menu option choices.
* items - ARRAY of pulled down menu items.
* columns - ARRAY of column numbers for each top level option.
* starts - ARRAY of starting element numbers.
* prompts - Optional ARRAY corresponding menu item messages.
* exit - Optional LOGICAL indicating if escape will exit.
* Default is True.
*
* Returns...:
*
*
*
*****************************************************************************
FUNCTION PDOWNMENU
PARAMETERS pullmenu, pullitem, pmenus, pitems, pcols, pstarts, pprompts, pexit
PRIVATE fc_incolor, fc_display, fc_menubar, fc_box_on, fc_box_off,;
fc_selitem, fc_selmenu
*-- verify parameters and types
IF TYPE('pullmenu') + TYPE('pullitem') + TYPE('pmenus') +;
TYPE('pitems') + TYPE('pstarts') + TYPE('pcols') != 'NNAAAA'
RETURN 0
ENDIF
prmts_on = IF( TYPE('pprompts') = 'A', .T., .F. ) && if prompts being displayed
prmt_row = IF( TYPE('prmtrow') = 'N', prmtrow, 24 ) && row for prompt messages
pexit = IF( TYPE('pexit') = 'L', pexit, .T. )
*-- retrieve and store colors so they can be used by descriptive names
fc_incolor = rl_pd[ 4]
fc_display = rl_pd[ 6]
fc_menubar = rl_pd[ 7]
fc_box_on = rl_pd[ 8]
fc_box_off = rl_pd[ 9]
fc_selitem = rl_pd[10]
fc_selmenu = rl_pd[ 5]
*-- first pop the screen that was saved during the initialization
*-- in case the routine that calls PDOWNMENU() messed with the screen
*-- since it was painted with PDOWNINIT()
RESTSCREEN( rl_pd[11], rl_pd[12], rl_pd[13], rl_pd[14], rl_pd[15] )
*-- make sure the menu and item numbers supplied are within array bounds
pullmenu = IF( pullmenu < 1 .OR. pullmenu > LEN(pmenus), 1, pullmenu )
*-- if an option is selected from a pull down, pullitem will = option number
DO WHILE .T.
*-- if we are to go back into the pulled down menu, do it
IF pullitem > 0
pullitem = PULLDOWN_2()
ELSE
*-- otherwise, stay in top level menu
*-- display current selection in reverse video
SETCOLOR(fc_menubar)
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
SETCOLOR(fc_display)
*-- wait for a key
f_lkey = INKEY(0)
DO CASE
CASE f_lkey = 4 .OR. f_lkey = 32
*-- Right Arrow or Space Bar
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
pullmenu = IF( pullmenu = LEN(pmenus), 1, pullmenu + 1 )
CASE f_lkey = 19 .OR. f_lkey = 8
*-- Left Arrow or Back Space
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
pullmenu = IF( pullmenu = 1, LEN(pmenus), pullmenu - 1 )
CASE f_lkey = 1
*-- Home Key
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
pullmenu = 1
CASE f_lkey = 6
*-- End key
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
pullmenu = LEN(pmenus)
CASE f_lkey = 13
*-- Enter key
SETCOLOR(fc_selmenu)
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
*-- go into pull down menu with side stepping
pullitem = PULLDOWN_2()
CASE UPPER(CHR(f_lkey)) $ rl_pd[2]
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
x = 1
pullmenu = 0
DO WHILE pullmenu = 0
pullmenu = AT(UPPER(CHR(f_lkey)),SUBSTR(rl_pd[2],x,LEN(pmenus)))
x = x + LEN(pmenus)
ENDDO
SETCOLOR(fc_selmenu)
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
pullitem = PULLDOWN_2()
CASE f_lkey = 27 .AND. pexit
*-- Escape allowed to exit
pullmenu = 0
EXIT
ENDCASE
ENDIF
*-- if an option was selected, exit
IF pullitem != 0
EXIT
ENDIF
ENDDO
**-- display selected option in bright color
*IF pullmenu > 0 .AND. pullmenu <= LEN(pmenus)
* SETCOLOR(fc_selitem)
* @ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
*ENDIF
**-- if messages are on, clear the message line
*IF prmts_on
* @ prmt_row,0
*ENDIF
*-- restore original color
SETCOLOR(fc_incolor)
RETURN IF( pullmenu = 0, 0, pstarts[pullmenu] + pullitem - 1 )
FUNCTION PullDown_2
* Syntax....: PULLDOWN_2()
*
*
*-- this proc displays top menu option in selected color and paints menu
DO pd2_setup
DO WHILE .T.
*-- display current selection in (selected) video
SETCOLOR(fc_menubar)
@ rl_pd[11]+1+pullitem,pcols[pullmenu]+1 SAY pitems[ pstarts[pullmenu]+pullitem-1 ]
SETCOLOR(fc_display)
*-- if message prompts are on, clear row and display
IF prmts_on
@ prmt_row,0
@ prmt_row,(80-LEN( pprompts[ pstarts[pullmenu]+pullitem-1 ] ))/2 ;
SAY pprompts[ pstarts[pullmenu]+pullitem-1 ]
ENDIF
*-- wait for a key
f_lkey = INKEY(0)
DO CASE
CASE f_lkey = 4 .OR. f_lkey = 32
*-- Right Arrow or Space Bar
pullmenu = IF( pullmenu = LEN(pmenus), 1, pullmenu + 1 )
pullitem = 1
DO pd2_setup
CASE f_lkey = 19 .OR. f_lkey = 8
*-- Left Arrow or Back Space
pullmenu = IF( pullmenu = 1, LEN(pmenus), pullmenu - 1 )
pullitem = 1
DO pd2_setup
CASE f_lkey = 24
*-- Down Arrow
@ rl_pd[11]+1+pullitem,pcols[pullmenu]+1 SAY pitems[ pstarts[pullmenu]+pullitem-1 ]
pullitem = IF( pullitem = pd_counts[pullmenu], 1, pullitem + 1 )
CASE f_lkey = 5
*-- Up Arrow or Back Space
@ rl_pd[11]+1+pullitem,pcols[pullmenu]+1 SAY pitems[ pstarts[pullmenu]+pullitem-1 ]
pullitem = IF( pullitem = 1, pd_counts[pullmenu], pullitem - 1 )
CASE f_lkey = 1
*-- Home Key
@ rl_pd[11]+1+pullitem,pcols[pullmenu]+1 SAY pitems[ pstarts[pullmenu]+pullitem-1 ]
pullitem = 1
CASE f_lkey = 6
*-- End key
@ rl_pd[11]+1+pullitem,pcols[pullmenu]+1 SAY pitems[ pstarts[pullmenu]+pullitem-1 ]
pullitem = pd_counts[pullmenu]
CASE f_lkey = 13
*-- Enter key
EXIT
CASE UPPER(CHR(f_lkey)) $ pd_altkeys[pullmenu]
@ rl_pd[11]+1+pullitem,pcols[pullmenu]+1 SAY pitems[ pstarts[pullmenu]+pullitem-1 ]
x = 1
pullitem = 0
DO WHILE pullitem = 0
pullitem = AT(UPPER(CHR(f_lkey)),SUBSTR(pd_altkeys[pullmenu],x,pd_counts[pullmenu]))
x = x + pd_counts[pullmenu]
ENDDO
EXIT
CASE f_lkey = 27
*-- Escape request
pullitem = 0
EXIT
ENDCASE
ENDDO
IF pullitem = 0
*-- restore original screen and color
RESTSCREEN( rl_pd[11], rl_pd[12], rl_pd[13], rl_pd[14], rl_pd[15] )
ELSE
*-- display selected option in bright color
SETCOLOR(fc_selitem)
@ rl_pd[11]+1+pullitem,pcols[pullmenu]+1 SAY pitems[ pstarts[pullmenu]+pullitem-1 ]
SETCOLOR(fc_box_off)
@ rl_pd[11]+1, pcols[pullmenu], pd_bottoms[pullmenu], pd_rights[pullmenu] BOX '┌─┐│┘─└│'
ENDIF
*-- if messages are on, clear the message line
SETCOLOR(fc_display)
IF prmts_on
@ prmt_row,0
ENDIF
RETURN (pullitem)
*******************
PROCEDURE pd2_setup
*******************
*-- restore original screen underneath
RESTSCREEN( rl_pd[11], rl_pd[12], rl_pd[13], rl_pd[14], rl_pd[15] )
*-- display the top bar item in selected color
SETCOLOR(fc_selmenu)
@ rl_pd[11],pcols[pullmenu] SAY pmenus[pullmenu]
*-- now draw the box for the menu using the maximum width of options
SETCOLOR(fc_box_on)
@ rl_pd[11]+1, pcols[pullmenu], pd_bottoms[pullmenu], pd_rights[pullmenu] BOX '╔═╗║╝═╚║'
SETCOLOR(fc_display)
** SCROLL( rl_pd[11]+2, pcols[pullmenu]+1, pd_bottoms[pullmenu]-1, pd_rights[pullmenu]-1, 0)
IF NEXTKEY() = 4 .OR. NEXTKEY() = 19
*-- if stomping down on arrow keys, skip this stuff
RETURN
ENDIF
*-- display options
FOR x = 1 TO pd_counts[pullmenu]
@ rl_pd[11]+1+x,pcols[pullmenu]+1 SAY pitems[ pstarts[pullmenu]+x-1 ]
NEXT x
*-- starting choice is always 1, if not already specified
pullitem = IF( pullitem <= 0, 1, pullitem )
RETURN